/*
 * Funny Language - a free style programming language.
 * Copyright (C) 2015 by fanguangping (fanguangping@163.com)
 * env.c
 */

#include <stdio.h>
#include <memory.h>
#include "../basic/operator.h"

/*
 * 环境
 *
 * */

/*
void new_frame_in_env(Scheme *sc, Cell* oldEnv) {
	Cell* newFrame = G_NIL;
	if (oldEnv == G_NIL)
		newFrame = make_vector(sc, 461);
	sc->env = immutable_cons(sc, newFrame, oldEnv);
	//(sc->env)->_flag = T_ENVIRONMENT;
	(sc->env)->_type = ENVIRONMENT_TYPE;
}

static void new_slot_in_environment(Scheme *sc, Cell* env, Cell* var, Cell* value) {
	Cell* slot = immutable_cons(sc, var, value);
    Cell* frame = car(env);
	if (type_of(sc, frame, VECTOR_TYPE)) {
		int location = hash_fn(var->_name, frame->_longValue);
		set_vector_item(frame, location,
				immutable_cons(sc, slot, get_vector_item(frame, location)));
	} else {
		env->_pair._car = immutable_cons(sc, slot, frame);
	}
}

void new_slot_in_env(Scheme *sc, Cell* var, Cell* value) {
	new_slot_in_environment(sc, sc->env, var, value);
}

Cell* find_slot_in_env(Scheme *sc, Cell* env, Cell* var, int all) {
	if (!is_pointer(var)) {
		return G_NIL;
	}

	for (; env != G_NIL; env = cdr(env)) {
		Cell* item = NULL;

        Cell* frame = car(env);
		if (type_of(sc, frame, VECTOR_TYPE)) {
			int location = hash_fn(var->_name, frame->_longValue);
			item = get_vector_item(frame, location);
		} else {
			item = frame;
		}
		for (; item != G_NIL; item = cdr(item)) {
			if (caar(item) == var)
				return car(item);
		}
		if (!all)
			return G_NIL;
	}
	return G_NIL;
}

void set_slot_in_env(Scheme *sc, Cell* var, Cell* value) {
	var->_pair._cdr = value;
}

Cell* slot_value_in_env(Cell* symbol) {
	return cdr(symbol);
}

// (interaction-environment)
Cell* op_int_env(Scheme *sc) {
	sc->returnValue = sc->globalEnv;
	return pop_callstack(sc);
}

// (current-environment)
Cell* op_curr_env(Scheme *sc) {
	sc->returnValue = sc->env;
	return pop_callstack(sc);
}
*/

// refer to SICP
void extend_environment(Scheme *sc, Cell* frame, Cell* baseEnv) {
    sc->env = immutable_cons(sc, frame, baseEnv);
    (sc->env)->_type = ENVIRONMENT_TYPE;
}

void add_binding_to_frame(Scheme *sc, Cell* frame, const char* var, Cell* val, int isConstant) {
    Cell* variable = (isConstant) ? make_constant(sc, var) : make_variable(sc, var);
    variable->_type = val->_type;
    Cell* slot = immutable_cons(sc, variable, val);
    int location = hash_fn(var, frame->_longValue);
    set_vector_item(frame, location, immutable_cons(sc, slot, get_vector_item(frame, location)));
}

static void print_frame(Scheme *sc, Cell* frame) {
    printf("FRAME:");
    int index = 0;
    int len = frame->_longValue;
    for (index = 0; index < len; index++) {
        Cell* elem = get_vector_item(frame, index);
        printf(" ");
        printf(cell2str(sc, elem));
    }
}

Cell* lookup_variable_value(Scheme *sc, Cell* env, const char* var) {
//    if (strcmp(var, "abc") == 0) {
//        printf("\n=====PRINT=====\n");
//        Cell* p = NULL;
//        for (p=env; p!=G_NIL;p=cdr(p)) {
//            Cell* f = first(p);
//            print_frame(sc, f);
//            printf("\n -> \n");
//        }
//        printf("\n=====PRINT=====\n");
//    }


    if (env == G_NIL) {
        return make_default_exception_1(sc, "UNBOUND_VARIABLE", "LOOKUP - Unbound value: %s\n", var);
    }
    Cell* frame = first(env);
    int location = hash_fn(var, frame->_longValue);
    Cell* item = get_vector_item(frame, location);
    Cell* slot = NULL;
    for (; item != G_NIL; item = cdr(item)) {
        slot = car(item);
        if (strcmp(car(slot)->_name, var) == 0) {
            return cdr(slot);
        }
    }
    return lookup_variable_value(sc, cdr(env), var);
}

Cell* set_variable_value(Scheme *sc, Cell* env, const char* var, Cell* val) {
    if (env == G_NIL) {
        return make_default_exception_1(sc, "UNBOUND_VARIABLE", "SET - Unbound value: %s\n", var);
    }
    Cell* frame = first(env);
    int location = hash_fn(var, frame->_longValue);
    Cell* item = get_vector_item(frame, location);
    Cell* slot = NULL;
    for (; item != G_NIL; item = cdr(item)) {
        slot = car(item);
        if (strcmp(car(slot)->_name, var) == 0) {
            if (is_constant(car(slot))) {
                return make_default_exception_1(sc, "CONSTANT_IMMUTABLE", "SET - Constant is immutable: %s\n", var);
            }
            CDR(slot) = val;
            return G_TRUE;
        }
    }
    return set_variable_value(sc, cdr(env), var, val);
}

Cell* define_variable(Scheme *sc, Cell* env, const char* var, Cell* val) {
    Cell* frame = first(env);
    int location = hash_fn(var, frame->_longValue);
    Cell* item = get_vector_item(frame, location);
    Cell* slot;
    for (; item != G_NIL; item = cdr(item)) {
        slot = car(item);
        if (strcmp(car(slot)->_name, var) == 0) {
            return make_default_exception_1(sc, "REDEFINITION", "DEFINE - Redefinition of %s\n", var);
        }
    }
    add_binding_to_frame(sc, frame, var, val, FALSE);
    return G_TRUE;
}

void define_global_constant(Scheme *sc, const char* var, Cell* val) {
    Cell* frame = first(sc->globalEnv);
    add_binding_to_frame(sc, frame, var, val, TRUE);
}

/*
void init_environment_operators(Scheme *sc) {
	ADD_OPERATOR(sc, "interaction-environment", int_env);
	ADD_OPERATOR(sc, "current-environment", curr_env);
}
*/
